(library (renderer)
  (export render-data)
  (import (rnrs base)
          (only (guile)
                lambda* λ
                ;; control flow
                when
                ;; ports
                current-output-port
                call-with-output-string
                with-output-to-port
                ;; string procs
                string-downcase
                string-trim-right
                ;; other
                simple-format)

          (ice-9 exceptions)
          (ice-9 textual-ports)
          (ice-9 pretty-print)
          (ice-9 match)

          (prefix (srfi srfi-1) srfi-1:)
          (prefix (srfi srfi-69) srfi-69:)

          (prefix (logging) log:)
          (lib string-utils)
          (lib alist-utils)
          (lib list-utils)))


;; (define render-entity-old
;;   (lambda* (entity #:key (indentation-level 0))
;;     (log:debug "rendering entity:" entity)
;;     (call-with-output-string
;;       (λ (string-port)
;;         (let render-iter ([attrs (cdr entity)])
;;           (log:debug "rendering attributes:" attrs)
;;            (cond
;;             [(member-recursively 'ID-ATTRIBUTE attrs #:test symbol=?)
;;              =>
;;              (λ (id-attr)
;;                (log:debug "got id-attr:" id-attr)
;;                (match id-attr
;;                  [('ID-ATTRIBUTE _ entity-id)
;;                   (put-string string-port "id: ")
;;                   (put-string string-port entity-id)]
;;                  [_ (error "unrecognized pattern of id attribute" id-attr)])
;;                (render-iter (remove-member-recursively attrs id-attr #:test equal?)))]
;;             [else
;;              "\n"]))))))


(define render-entity
  (lambda* (#:key
            (id #f)
            (x-coord #f)
            (y-coord #f)
            (hp #f)
            (act #f)
            (ratio #f)
            (times #f)
            (reserve #f)
            (join #f)
            (join-reserve #f)
            (boss #f)
            (soldier #f)
            (entity-comment #f))
    ;; (define output-if-set
    ;;   (λ (attr port)
    ;;     ))
    ;; (log:debug "id:" id)
    ;; (log:debug "xcoord:" x-coord)
    ;; (log:debug "ycoord:" y-coord)
    ;; (log:debug "hp:" hp)
    ;; (log:debug "act:" act)
    ;; (log:debug "ratio:" ratio)
    ;; (log:debug "times:" times)
    ;; (log:debug "reserve:" reserve)
    ;; (log:debug "join:" join)
    ;; (log:debug "join-reserve:" join-reserve)
    ;; (log:debug "boss:" boss)
    ;; (log:debug "soldier:" soldier)
    ;; (log:debug "entity-comment:" entity-comment)
    (let ([attr-sep "  "])
      (string-append
       (string-trim-right
        (call-with-output-string
          (λ (port)
            (when id
              (match id
                [(label id)
                 (simple-format port "id: ~a~a" id attr-sep)]))

            (when hp
              (match hp
                [(label hp)
                 (simple-format port "hp: ~a~a" hp attr-sep)]))

            (when act
              (match act
                [(label act)
                 (simple-format port "act: ~a~a" act attr-sep)]))

            (when x-coord
              (match x-coord
                [(label x)
                 (simple-format port "x: ~a~a" x attr-sep)]))

            (when y-coord
              (match y-coord
                [(label y)
                 (simple-format port "y: ~a~a" y attr-sep)]))

            (when reserve
              (simple-format port "reserve: ~a~a" reserve attr-sep))

            (when times
              (match times
                [(label times)
                 (simple-format port "times: ~a~a" times attr-sep)]))

            (when entity-comment
              (match entity-comment
                [(comment-start (label comment-text))
                 (simple-format port "#~a~a" comment-text attr-sep)]))

            (when ratio
              (match ratio
                [(label ratio)
                 (simple-format port "ratio: ~a~a" ratio attr-sep)]))

            (when boss
              (simple-format port "<boss>~a" attr-sep))

            (when soldier
              (simple-format port "<soldier>~a" attr-sep))

            (when join
              (simple-format port "join: ~a~a" join attr-sep))

            (when join-reserve
              (simple-format port "join_reserve: ~a~a" join-reserve attr-sep)))))
       "\n"))))


(define render-data
  (lambda* (data #:key (port (current-output-port)) (indentation-level 0))
    ;; Match the data, always returning 3 values: (1) the
    ;; output string part of the matched data is serialized
    ;; to, (2) the data which shall be continued to be
    ;; matched and (3) an indentation level for proper
    ;; indentation of the output string.
    (let-values ([(output remaining-data indentation-level)
                  (match data
                    [() (values "" '() indentation-level)]
                    ;; PHASE tagged data itself is not carrying required
                    ;; data. Required data is inside the PHASE-TAG tagged
                    ;; data. So extract the PHASEs and output nothing.
                    [(('PHASE remaining-data ...))
                     (values ""
                             remaining-data
                             (+ indentation-level 1))]
                    ;; PHASE-TAG tagged data carries the actual string <phase>,
                    ;; which should be output. Then continue with the remaining
                    ;; data.
                    [(('PHASE-TAG val) remaining-data ...)
                     (values (string-indent (string-append val " ") indentation-level)
                             remaining-data
                             (+ indentation-level 1))]
                    ;; COMMENT tagged data itself does not carry any important
                    ;; information. The information is inside the enclosed
                    ;; parts.
                    [(('COMMENT _ ('COMMENT-TEXT text)) remaining-data ...)
                     (values (string-append "# " text "\n")
                             remaining-data
                             indentation-level)]

                    ;; Match bound followed by a comment, to avoid breaking the
                    ;; line, when there is a comment and output a break when
                    ;; there is no comment.
                    [(('BOUND-ATTRIBUTE _ val) ('COMMENT start text) remaining-data ...)
                     (values (string-append "bound: " val " ")
                             `((COMMENT ,start ,text) ,@remaining-data)
                             indentation-level)]
                    [(('BOUND-ATTRIBUTE _ ... val) remaining-data ...)
                     (values (string-append "bound: " val "\n")
                             remaining-data
                             indentation-level)]

                    [(('MUSIC-SWITCH
                       ('MUSIC-ATTRIBUTE ('MUSIC-ATTRIBUTE-NAME _)
                                         ('FILENAME filename)))
                      remaining-data ...)
                     (values (string-indent (string-append  "music: " filename "\n")
                                            indentation-level)
                             remaining-data
                             indentation-level)]

                    ;; PHASE-ENTITIES tagged data does not itself contain the
                    ;; relevant data. To avoid problems with the end tag of a
                    ;; phase, the end tag is put into the same list as phase
                    ;; entities.
                    [(('PHASE-ENTITIES entities ...) end-tag)
                     (values ""
                             `(,@entities ,end-tag)
                             indentation-level)]
                    ;; Match phase entities without the end tag.
                    [(('PHASE-ENTITIES entities ...))
                     (values ""
                             `(,@entities)
                             indentation-level)]

                    [(('ENTITY attrs ...) other-entities ...)
                     (values (string-indent
                              (apply render-entity
                                     (alist->keyword-value-list
                                      attrs
                                      #:preprocess
                                      (λ (sym)
                                        (string->symbol
                                         (let* ([downcased (string-downcase (symbol->string sym))])
                                           (string-remove-suffixes downcased '("-attribute" "-tag")))))))
                              indentation-level
                              #:indentation-width 8)
                             other-entities
                             indentation-level)]

                    [(('PHASE-END-TAG end-tag))
                     (values (string-indent (string-append end-tag "\n")
                                            (- indentation-level 1)
                                            #:indentation-width 8)
                             '()
                             (- indentation-level 1))])])

      (put-string port output)
      ;; (pretty-print remaining-data #:port port)
      (cond
       [(null? remaining-data) 'done]
       [else
        ;; (display remaining-data) (newline)
        (render-data remaining-data #:port port #:indentation-level indentation-level)]))))
